home *** CD-ROM | disk | FTP | other *** search
/ A.C.E. 2 / ACE CD 2.iso / FILES / UTILS / HSBASIC2.DMS / in.adf / HB2Examples1.3.Lha / Examples / RPDump / RPDump.bas < prev   
Encoding:
BASIC Source File  |  1994-04-29  |  6.5 KB  |  248 lines
  1. ''
  2. '' $Id: RPDump.bas,v 1.3 1994/04/29 15:46:21 alex Rel $
  3. ''
  4. '' How to dump a RastPort to the printer
  5. ''
  6. '' Derived from RKM example (c) Copyright 1992 Commodore-Amiga, Inc.
  7. ''
  8.  
  9. DEFINT A-Z
  10.  
  11. 'REM $INCLUDE Exec.bh
  12. 'REM $INCLUDE Graphics.bh
  13. 'REM $INCLUDE Intuition.bh
  14. 'REM $INCLUDE DOS.bc
  15. 'REM $INCLUDE Printer.bc
  16.  
  17. REM $INCLUDE BLib/ExecSupport.bas
  18.  
  19. LIBRARY OPEN "exec.library", LIBRARY_MINIMUM&
  20. LIBRARY OPEN "graphics.library", LIBRARY_MINIMUM&
  21. LIBRARY OPEN "intuition.library", LIBRARY_MINIMUM&
  22.  
  23. FUNCTION dumpRP(BYVAL rp&, BYVAL cm&, BYVAL modeID&, ibox(4), BYVAL userAbort&)
  24.     STATIC pmp&, pio&, pd&, pio&, sigfr&, junk&, r
  25.  
  26.     dumpRP = -1    'generic failure
  27.  
  28.     ' Create private messageport
  29.     pmp& = CreatePort&(NULL&, 0)
  30.     IF pmp& <> NULL& THEN
  31.         ' Allocate Printer IO block
  32.         pio& = CreateExtIO&(pmp&, IODRPReq_sizeof)
  33.         IF pio& <> NULL& THEN
  34.             ' Open the printer.device
  35.             r = OpenDevice&(SADD("printer.device" + CHR$(0)), 0, pio&, 0)
  36.             IF r = 0 THEN
  37.                 ' Fill in the IODRPRequest
  38.                 POKEW pio& + IODRPReqio_Command, PRD_DUMPRPORT&
  39.                 POKEL pio& + io_RastPort, rp&
  40.                 POKEL pio& + io_ColorMap, cm&
  41.                 POKEL pio& + io_Modes, modeID&
  42.                 POKEW pio& + io_SrcX, ibox(0)
  43.                 POKEW pio& + io_SrcY, ibox(1)
  44.                 POKEW pio& + io_SrcWidth, ibox(2)
  45.                 POKEW pio& + io_SrcHeight, ibox(3)
  46.  
  47.                 POKEL pio& + io_DestCols, 0
  48.                 POKEL pio& + io_DestRows, 0
  49.                 POKEW pio& + io_Special, SPECIAL_ASPECT&
  50.  
  51.                 ' Always give the user a change to abort.
  52.                 ' So we'll use SendIO(), instead of DoIO(), to be asynch and
  53.                 ' catch a possible user request to abort printing
  54.  
  55.                 SendIO pio&
  56.  
  57.                 ' Now Wait() for either a user signal or a printer.device signal
  58.  
  59.                 sigfr& = xWait&((1& << PEEKB(pmp& + mp_SigBit)) OR userAbort&)
  60.  
  61.                 IF sigfr& AND userAbort& THEN
  62.                     ' User wants to abort
  63.  
  64.                     AbortIO pio&
  65.                     junk& = WaitIO&(pio&)
  66.                 END IF
  67.  
  68.                 IF sigfr& AND (1& << PEEKB(pmp& + mp_SigBit)) THEN
  69.                     ' printer is either ready or an error has occurred
  70.  
  71.                     WHILE GetMsg&(pmp&)
  72.                         ' Remove any messages
  73.                     WEND
  74.                 END IF
  75.  
  76.                 ' Return error code (in this case we count user-abort as an error)
  77.                 dumpRP = PEEKB(pio& + IODRPReqio_Error)
  78.  
  79.                 CloseDevice pio&
  80.             ELSE
  81.                 dumpRP = r
  82.             END IF
  83.             DeleteExtIO pio&
  84.         END IF
  85.         DeletePort pmp&
  86.     END IF
  87. END FUNCTION
  88.  
  89. '
  90. ' How to use dumpRP to dump the contents of a window
  91. '
  92. FUNCTION dumpWindow(BYVAL win&, BYVAL userAbort&)
  93.     STATIC scr&, vp&, rp&, cm&, modeID&, junk
  94.     DIM ibox(4)
  95.  
  96.     scr& = PEEKL(win& + WScreen)    ' the window's screen
  97.     vp& = scr& + ScreenViewPort        ' the ViewPort associated with the screen
  98.     IF PEEKW(LIBRARY("graphics.library") + lib_Version) >= 36 THEN
  99.         modeID& = GetVPModeID&(vp&)
  100.     ELSE
  101.         modeID& = PEEKW(vp& + ViewPortModes) AND &hffff&
  102.     END IF
  103.     cm& = PEEKL(vp& + ColorMap)    ' the ViewPort's colour map
  104.     rp& = PEEKL(win& + RPort)    ' the window's rastport
  105.     ibox(0) = PEEKW(win& + WindowLeftEdge)
  106.     ibox(1) = PEEKW(win& + WindowTopEdge)
  107.     ibox(2) = PEEKW(win& + WindowWidth)
  108.     ibox(3) = PEEKW(win& + WindowHeight)
  109.  
  110.     dumpWindow = dumpRP(rp&, cm&, modeID&, ibox(), userAbort&)
  111. END FUNCTION
  112.  
  113. '
  114. ' How to use dumpRP to dump a screen
  115. '
  116. FUNCTION dumpScreen(BYVAL scr&, BYVAL userAbort&)
  117.     STATIC scr&, vp&, rp&, cm&, modeID&
  118.     DIM ibox(4)
  119.  
  120.     vp& = scr& + ScreenViewPort    ' the ViewPort associated with the screen
  121.     IF PEEKW(LIBRARY("graphics.library") + lib_Version) >= 36 THEN
  122.         modeID& = GetVPModeID&(vp&)
  123.     ELSE
  124.         modeID& = PEEKW(vp& + ViewPortModes) AND &hffff&
  125.     END IF
  126.     cm& = PEEKL(vp& + ColorMap)    ' the ViewPort's colour map
  127.     rp& = scr& + RastPort    ' the screen's rastport
  128.     ibox(0) = PEEKW(scr& + ScreenLeftEdge)
  129.     ibox(1) = PEEKW(scr& + ScreenTopEdge)
  130.     ibox(2) = PEEKW(scr& + ScreenWidth)
  131.     ibox(3) = PEEKW(scr& + ScreenHeight)
  132.  
  133.     dumpScreen = dumpRP(rp&, cm&, modeID&, ibox(), 0)
  134. END FUNCTION
  135.  
  136. '
  137. ' This one's just for illustration, how to use our dumpRP routine to dump
  138. ' the current front-most screen (which is not necessarily one of BASIC's)
  139. '
  140. FUNCTION dumpFrontScreen(BYVAL userAbort&)
  141.     STATIC ilock&, scr&
  142.  
  143.     ilock& = LockIBase&(0)    ' lock IntuitionBase
  144.     ' if you call anything high level here, the system will dead-lock
  145.  
  146.     scr& = PEEKL(LIBRARY("intuition.library") + FirstScreen)
  147.     ' we should attempt to lock the screen open here, but since the front
  148.     ' screen may be private, we can't LockPubScreen it, lets just play
  149.     ' fast'n'loose & hope that the screen doesn't go away...
  150.  
  151.     UnlockIBase ilock&    ' release IntuitionBase lock
  152.  
  153.     dumpFrontScreen = dumpScreen(scr&, userAbort&)
  154. END FUNCTION
  155.  
  156. '
  157. ' A quick re-implementation of BASIC's PCOPY command, print the screen which
  158. ' has BASIC's idea of the current window on it (no way to quit, no errors, not
  159. ' a good routine in many ways...)
  160. '
  161. SUB ourPCOPY
  162.     STATIC junk
  163.  
  164.     junk = dumpScreen(WINDOW(7) + WScreen, 0)
  165. END SUB
  166.  
  167. '
  168. ' Turn an error code (IOERR from Exec or PDERR from the printer) into a string
  169. ' explaining what went wrong
  170. '
  171. FUNCTION drpErrorString$(BYVAL r)
  172.     SELECT CASE r&
  173.         CASE IOERR_OPENFAIL
  174.             drpErrorString$ = "device/unit failed to open"
  175.  
  176.         CASE IOERR_ABORTED
  177.             drpErrorString$ = "request terminated early"
  178.  
  179.         CASE IOERR_NOCMD
  180.             drpErrorString$ = "command not supported by device"
  181.  
  182.         CASE IOERR_BADLENGTH
  183.             drpErrorString$ = "not a valid length"
  184.  
  185.         CASE IOERR_BADADDRESS
  186.             drpErrorString$ = "invalid address (misaligned or bad range)"
  187.  
  188.         CASE IOERR_UNITBUSY
  189.             drpErrorString$ = "device opens ok, but requested unit is busy"
  190.  
  191.         CASE IOERR_SELFTEST
  192.             drpErrorString$ = "hardware failed self-test"
  193.  
  194.         CASE PDERR_CANCEL
  195.             drpErrorString$ = "user cancelled print"
  196.  
  197.         CASE PDERR_NOTGRAPHICS
  198.             drpErrorString$ = "printer cannot output graphics"
  199.  
  200.         CASE PDERR_BADDIMENSION
  201.             drpErrorString$ = "print dimensions illegal"
  202.  
  203.         CASE PDERR_INTERNALMEMORY
  204.             drpErrorString$ = "no memory for internal variables"
  205.  
  206.         CASE PDERR_BUFFERMEMORY
  207.             drpErrorString$ = "no memory for print buffer"
  208.  
  209.         CASE ELSE
  210.             drpErrorString$ = ""
  211.     END SELECT
  212. END FUNCTION
  213.  
  214. SUB main
  215.     STATIC r
  216.  
  217.     ' We'll print the contents, of BASIC's default window; this code works
  218.     ' out the necessary values
  219.     ' Since BASIC normally uses a gimme-zero-zero window, the associated window
  220.     ' RastPort has none of the window furniture in it
  221.  
  222.     ' Draw something in the window (imaginative huh...)
  223.     COLOR 3
  224.     LOCATE 9, 13
  225.     PRINT "Hello World"
  226.     COLOR 1
  227.  
  228.     ' we pass ^C as a possible user abort signal; Program[Break] from the
  229.     ' HiSoft BASIC Editor would cause such a signal to be generated, or you
  230.     ' could use the Break command from a CLI
  231.  
  232.     r = dumpWindow(WINDOW(7), SIGBREAKF_CTRL_C&)
  233.  
  234.     IF r <> 0 THEN
  235.         PRINT drpErrorString$(r)
  236.     END IF
  237.  
  238.     ' Now dump the front-most screen (could be any screen in the system)
  239.  
  240.     r = dumpFrontScreen(SIGBREAKF_CTRL_C&)
  241.     IF r <> 0 THEN
  242.         PRINT drpErrorString$(r)
  243.     END IF
  244. END SUB
  245.  
  246. main
  247. END
  248.